home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectDraw / Tutorials / Tut1 / DDTut1.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  3.9 KB  |  113 lines
  1. VERSION 5.00
  2. Begin VB.Form DDTut1 
  3.    Caption         =   "DirectDraw Tutorial 1"
  4.    ClientHeight    =   4485
  5.    ClientLeft      =   570
  6.    ClientTop       =   690
  7.    ClientWidth     =   5670
  8.    Icon            =   "DDTut1.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   299
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   378
  13.    Begin VB.PictureBox Picture1 
  14.       ClipControls    =   0   'False
  15.       Height          =   4452
  16.       Left            =   0
  17.       ScaleHeight     =   4395
  18.       ScaleWidth      =   5595
  19.       TabIndex        =   0
  20.       Top             =   0
  21.       Width           =   5652
  22.    End
  23. Attribute VB_Name = "DDTut1"
  24. Attribute VB_GlobalNameSpace = False
  25. Attribute VB_Creatable = False
  26. Attribute VB_PredeclaredId = True
  27. Attribute VB_Exposed = False
  28. Option Explicit
  29. Option Compare Text
  30. 'Module level variables
  31. Dim objDX As New DirectX7
  32. Dim objDD As DirectDraw7
  33. Dim objDDSurf As DirectDrawSurface7
  34. Dim objDDPrimSurf As DirectDrawSurface7
  35. Dim ddsd1 As DDSURFACEDESC2
  36. Dim ddsd2 As DDSURFACEDESC2
  37. Dim ddClipper As DirectDrawClipper
  38. Dim bInit As Boolean
  39. Private Sub Form_Load()
  40.     init
  41. End Sub
  42. Sub init()
  43.     Dim sMedia As String
  44.     'Initialization procedure
  45.       
  46.     'The empty string parameter means to use the active display driver
  47.     Set objDD = objDX.DirectDrawCreate("")
  48.     'Notice that the show event calls Form_Resize
  49.         
  50.     'Indicate this app will be a normal windowed app
  51.     'with the same display depth as the current display
  52.     Call objDD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
  53.     'Indicate that the ddsCaps member is valid in this type
  54.     ddsd1.lFlags = DDSD_CAPS
  55.     'This surface is the primary surface (what is visible to the user)
  56.     ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
  57.     'Your creating the primary surface now with the surface description you just set
  58.     Set objDDPrimSurf = objDD.CreateSurface(ddsd1)
  59.     'Call the FindMediaDir procedure
  60.     sMedia = FindMediaDir("lake.bmp")
  61.     If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
  62.     'Now let's set the second surface description
  63.     ddsd2.lFlags = DDSD_CAPS
  64.     'This is going to be a plain off-screen surface
  65.     ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  66.     'Now we create the off-screen surface
  67.     Set objDDSurf = objDD.CreateSurfaceFromFile(sMedia & "lake.bmp", ddsd2)
  68.     Set ddClipper = objDD.CreateClipper(0)
  69.     ddClipper.SetHWnd Picture1.hWnd
  70.     objDDPrimSurf.SetClipper ddClipper
  71.     'Yes it has been initialized and is ready to blit
  72.     bInit = True
  73.     'Ok now were ready to blit this thing, call the blt procedure
  74.     blt
  75. End Sub
  76. Private Sub Form_Resize()
  77.     'This procedure is called by the me.show event or when
  78.     'The form is resized during runtime.
  79.     'Since DX uses pixels and VB uses twips this procedure
  80.     'Syncs up the two scales
  81.     'Remember to change the ScaleMode property on the
  82.     'Form to Pixels. Notice the Width and Height of the form
  83.     'Stay in twips even after you change the ScaleMode, but
  84.     'The ScaleWidth and the ScaleHeight are now in pixels.
  85.     Picture1.Width = Me.ScaleWidth
  86.     Picture1.Height = Me.ScaleHeight
  87.     blt
  88. End Sub
  89. Sub blt()
  90.         
  91.     'Has it been initialized? If not let's get out of this procedure
  92.     If bInit = False Then Exit Sub
  93.     'Some local variables
  94.     Dim ddrval As Long
  95.     Dim r1 As RECT
  96.     Dim r2 As RECT
  97.     'Gets the bounding rect for the entire window handle, stores in r1
  98.     objDX.GetWindowRect Picture1.hWnd, r1
  99.     r2.Bottom = ddsd2.lHeight
  100.     r2.Right = ddsd2.lWidth
  101.     ddrval = objDDPrimSurf.blt(r1, objDDSurf, r2, DDBLT_WAIT)
  102. End Sub
  103. Private Sub Picture1_Paint()
  104.     'This procedure is called during runtime when the form
  105.     'is moved or resized.
  106.     Do While objDD.TestCooperativeLevel <> DD_OK
  107.         DoEvents
  108.     Loop
  109.     objDD.RestoreAllSurfaces
  110.     init
  111.     blt
  112. End Sub
  113.